home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Pocket 6.3 / Extensions / fvgFloatingPoint next >
Text File  |  1993-06-07  |  2KB  |  60 lines
  1. \ FVG Compliance                        10 May 1993
  2.  
  3. \ This file brings Pocket Forth's floating point math into
  4. \ compliance with the ad hoc FVG floating point standard.
  5.  
  6. \ Numeric input is an exception. As allways any number with
  7. \ a decimal point is interpreted as a floating point number.
  8. \ If you want a double number, use the sequence: 123456x f>d.
  9. \ The standard calls for fp numbers to contain an E. This is
  10. \ supported but not required by Pocket Forth.
  11. 0 28 +md !
  12.  
  13. variable (PLACES)  4 (places) !  \ decimal places for f.
  14.  
  15. \ utility words
  16. : fflag  fcompare >r fdrop fdrop r> ;
  17. : f?nip  IF fswap THEN fdrop ;
  18.  
  19. \ words to be redefined
  20. : (fnumber)  fnumber ;
  21. : (f.)  f. ;
  22. : (fix)  fix ;
  23.  
  24. \ Words supported by the standard follow:
  25. : FACOS ( f -- acos[f] )
  26.     fdup  1.0 fswap f-  fswap 1.0 f+  f/  fsqrt fatn 2.0 f* ;
  27. : FASIN ( f -- asin[f] ) ( from Apple Numerics Manual, 2nd ed. )
  28.     fdup fabs 1.16415321827e-10 fcompare >r fdrop r> 0> IF
  29.       fdup 0.5 fflag 0> IF
  30.         1. fswap f-  fdup 2. f* fswap fdup f* f-  ELSE
  31.         1. fswap fdup f* f-  THEN
  32.       fsqrt f/ fatn  ELSE
  33.       fdrop  THEN ;
  34. : PI ( -- f.pi ) 0.0 facos 2.0 f* ;
  35. : FLOG ( f -- logf ) fln 10. fln f/ ;
  36. : FALOG ( f -- 10^f ) 10. fswap f^ ;
  37. : FALN ( f -- e^f ) fexp ;
  38. : F**  ( f1 f2 -- f1^f2 ) f^ ;
  39. : FMAX ( f1 f2 -- fmax ) fcompare 0> f?nip ;
  40. : FMIN ( f1 f2 -- fmin ) fcompare 0< f?nip ;
  41. : F= ( f1 f2 -- flag ) fflag 0= ;
  42. : F< ( f1 f2 -- flag ) fflag 0< ;
  43. : F> ( f1 f2 -- flag ) fflag 0> ;
  44. : F0= ( f -- flag ) 0. f= ;
  45. : F0< ( f -- flag ) 0. f< ;
  46. : F0> ( f -- flag ) 0. f> ;
  47. : FOVER ( f1 f2 --f1 f2 f1 ) 2 fpick ;
  48. : FROT ( f1 f2 f3 -- f2 f3 f1 ) 3 froll ;
  49. : FLOAT ( d -- f ) d>f ;
  50. : INT ( f -- d ) f>d ;
  51. : PLACES ( n -- ) (places) ! ;
  52. : E. ( f -- ) 18 sci f. ;
  53.  
  54. \ redefined words
  55. : FNUMBER ( addr -- f ) >abs (fnumber) ;  ( new def'n for FNUMBER )
  56. : F. ( f -- ) (places) @ fix (f.) ;  ( new definition for F.  )
  57. : FIX ( f -- d ) .5 f+ fint f>d ;  ( new definition for FIX )
  58.  
  59. -1 28 +md !
  60.